home *** CD-ROM | disk | FTP | other *** search
/ Your Choice 3 / Your Choice Software Collection 3.iso / os2 / etelr21 / etfieldo.vrm < prev    next >
Text File  |  1994-09-13  |  14KB  |  384 lines
  1. /* Custom mainline for macro */
  2.  
  3.     call RXFuncAdd "VRLoadFuncs", "VROBJ", "VRLoadFuncs"
  4.     call VRLoadFuncs
  5.  
  6.     _VREVersion = SubWord( VRVersion( "VRObj" ), 1, 1 )
  7.     if( _VREVersion < 2.10 )then do
  8.         call VRMessage "", "This program requires VX-REXX version 2.1 to run.", "Error!"
  9.         return 32000
  10.     end
  11.  
  12.     signal on SYNTAX name _VRESyntax
  13.     signal _VREMain
  14.  
  15. _VRESyntax:
  16.     parse source . . _VRESourceSpec
  17.     call VRMessage "", "Syntax error in" _VRESourceSpec "line" SIGL":" ErrorText(rc), "Error!"
  18.     call VRFini
  19.     exit 32000
  20.  
  21. _VREMain:
  22. /*:VRX         Main
  23. */
  24. /*  Main
  25. */
  26. Main:
  27. /*  Process the arguments.
  28.     Get the parent window.
  29. */
  30.     parse source . calledAs .
  31.     parent = ""
  32.     argCount = arg()
  33.     argOff = 0
  34.     if( calledAs \= "COMMAND" )then do
  35.         if argCount >= 1 then do
  36.             parent = arg(1)
  37.             argCount = argCount - 1
  38.             argOff = 1
  39.         end
  40.     end
  41.     InitArgs.0 = argCount
  42.     if( argCount > 0 )then do i = 1 to argCount
  43.         InitArgs.i = arg( i + argOff )
  44.     end
  45.     drop calledAs argCount argOff
  46.  
  47. /*  Load the windows
  48. */
  49.     call VRInit
  50.     parse source . . spec
  51.     _VREPrimaryWindowPath = ,
  52.         VRParseFileName( spec, "dpn" ) || ".VRW"
  53.     _VREPrimaryWindow = ,
  54.         VRLoad( parent, _VREPrimaryWindowPath )
  55.     drop parent spec
  56.     if( _VREPrimaryWindow == "" )then do
  57.         call VRMessage "", "Cannot load window:" VRError(), ,
  58.             "Error!"
  59.         _VREReturnValue = 32000
  60.         signal _VRELeaveMain
  61.     end
  62.  
  63. /*  Process events
  64. */
  65.     call Init
  66.     signal on halt
  67.     do while( \ VRGet( _VREPrimaryWindow, "Shutdown" ) )
  68.         _VREEvent = VREvent()
  69.         interpret _VREEvent
  70.     end
  71. _VREHalt:
  72.     _VREReturnValue = Fini()
  73.     call VRDestroy _VREPrimaryWindow
  74. _VRELeaveMain:
  75.     call VRFini
  76. exit _VREReturnValue
  77.  
  78. VRLoadSecondary: procedure
  79.     name = arg( 1 )
  80.  
  81.     window = VRLoad( VRWindow(), VRWindowPath(), name )
  82.     call VRMethod window, "CenterWindow"
  83.     call VRSet window, "Visible", 1
  84.     call VRMethod window, "Activate"
  85. return window
  86.  
  87. /*:VRX         CNField_DoubleClick
  88. */
  89. CNField_DoubleClick:
  90. recHandle = VRInfo( 'Record' )
  91. if recHandle = '' then
  92.     return
  93. caption = VRMethod( 'CNField', 'GetRecordAttr', recHandle, 'Caption' )
  94. if caption = 'Cancel' then do
  95.     call VRMessage 'Screen', 'The Cleared field cannot be hidden.  ', 'Information'
  96.     drop caption recHandle
  97.     return
  98. end
  99. stat = VRMethod( 'CNField', 'GetFieldData', recHandle, field.!Stat )
  100. if stat = 'Visible' then
  101.     call VRMethod 'CNField', 'SetFieldData', recHandle, field.!Stat, 'Hidden'
  102. else
  103.     call VRMethod 'CNField', 'SetFieldData', recHandle, field.!Stat, 'Visible'
  104. call VRMethod 'CNField', 'SetFieldData', recHandle, field.!Chge, 1
  105. return
  106.  
  107. /*:VRX         Fini
  108. */
  109. Fini:
  110.     window = VRWindow()
  111.     call VRSet window, "Visible", 0
  112.     drop window
  113. return 0
  114.  
  115. /*:VRX         Halt
  116. */
  117. Halt:
  118.     signal _VREHalt
  119. return
  120.  
  121. /*:VRX         Init
  122. */
  123. Init:
  124.     fields.0 = 0
  125.     call VRMethod 'Application', 'GetVar', 'args.'
  126.     call VRMethod 'Application', 'GetVar', 'fields.'
  127.     filename = args.1
  128.     tID = args.2
  129.     window = VRWindow()
  130.     call VRMethod window, "CenterWindow"
  131.     call VRSet window, "Visible", 1
  132.     call VRMethod window, "Activate"
  133.     drop window
  134. return
  135.  
  136. /*:VRX         MenuDef_Click
  137. */
  138. MenuDef_Click:
  139. call VRMethod 'CNField', 'RemoveRecord', 'All'
  140. fields.0 = 0
  141. signal Window1_Create
  142. return
  143.  
  144. /*:VRX         MenuExit_Click
  145. */
  146. MenuExit_Click:
  147. call Quit
  148. return
  149.  
  150. /*:VRX         MenuSave_Click
  151. */
  152. MenuSave_Click:
  153. call MenuSet_Click
  154. ClrFile = VRParseFilePath( filename, 'DPN' )||'.clr'
  155. TmpFile = VRParseFilePath( filename, 'DPN' )||'.cmp'
  156. rc = stream( ClrFile, 'c', 'open' )
  157. if rc <> 'READY:' then do
  158.     call VRMessage '', 'Error opening 'ClrFile'.  Field order will not be saved.  ', 'Error'
  159.     signal Quit
  160. end
  161. call VRLoadSecondary 'SWMsg'
  162. call stream ClrFile, 'c', 'seek =1'
  163. do forever
  164.     if( lines( ClrFile ) = 0 )then
  165.         leave
  166.     line = linein( ClrFile )
  167.     if line = '[Cleared]' then  do
  168.         call WriteFieldOrder
  169.         call lineout TmpFile, '[Cleared]'
  170.         leave
  171.     end
  172.     if line = '[FieldOrder]' then do
  173.         call WriteFieldOrder
  174.         do forever
  175.             if( lines( ClrFile ) = 0 )then
  176.                 leave
  177.             line = linein( ClrFile )
  178.             if line = '[Cleared]' then do
  179.                 call lineout TmpFile, line
  180.                 leave
  181.             end
  182.         end
  183.         leave
  184.     end
  185.     call lineout TmpFile, line
  186. end
  187. if( lines( ClrFile ) <> 0 )then do
  188.     do forever
  189.         if( lines( ClrFile ) = 0 )then
  190.             leave
  191.         line = linein( ClrFile )
  192.         if line <> '' then
  193.             call lineout TmpFile, line
  194.     end
  195. end
  196. call stream ClrFile, 'c', 'close'
  197. call stream TmpFile, 'c', 'close'
  198. call VRDestroy 'SWMsg'
  199. ok = VRDeleteFile( ClrFile )
  200. if ok = 0 then do
  201.     call VRMessage '', VRError(), 'Error'
  202.     return
  203. end
  204. if( \VRRenameFile( TmpFile, ClrFile ) )then do
  205.     call VRMessage '', VRError(), 'Error'
  206.     return
  207. end
  208. call VRMessage '', 'New field order has been saved.  The changes will be reflected the next time you open this ledger.  ', 'Information'
  209. drop ClrFile TmpFile field line id ok newfields.
  210. signal Quit
  211. return
  212.  
  213. WriteFieldOrder:
  214. call lineout TmpFile, '[FieldOrder]'
  215. do i = 1 to newfields.0
  216.     name = VRMethod( 'CNField', 'GetFieldData', newfields.i, field.!Name )
  217.     stat = VRMethod( 'CNField', 'GetFieldData', newfields.i, field.!Stat )
  218.     if stat = 'Hidden' then
  219.         stat = '<hidden>'
  220.     else
  221.         stat = ''
  222.     call lineout TmpFile, name||' '||stat
  223.     fields.i = name||' '||stat
  224. end
  225. call lineout TmpFile, ''
  226. return
  227.  
  228. /*:VRX         MenuSet_Click
  229. */
  230. MenuSet_Click:
  231. ok = VRMethod( "CNField", "GetRecordList", "All", "newfields." )
  232. call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'CNRegister', 'Painting', 0"
  233. do i = 1 to newfields.0
  234.     name = VRMethod( 'CNField', 'GetFieldData', newfields.i, field.!Name )
  235.     stat = VRMethod( 'CNField', 'GetFieldData', newfields.i, field.!Stat )
  236.     chge = VRMethod( 'CNField', 'GetFieldData', newfields.i, field.!Chge )
  237.     if chge = 1 then do
  238.         if name = 'Date' then do
  239.             if stat = 'Visible' then
  240.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Date, 'Visible', 1"
  241.             else
  242.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Date, 'Visible', 0"
  243.         end
  244.         if name = 'Number' then do
  245.             if stat = 'Visible' then
  246.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Number, 'Visible', 1"
  247.             else
  248.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Number, 'Visible', 0"
  249.         end
  250.         if name = 'Particulars' then do
  251.             if stat = 'Visible' then
  252.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Info, 'Visible', 1"
  253.             else
  254.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Info, 'Visible', 0"
  255.         end
  256.         if name = 'Credit' then do
  257.             if stat = 'Visible' then
  258.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Credit, 'Visible', 1"
  259.             else
  260.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Credit, 'Visible', 0"
  261.         end
  262.         if name = 'Debit' then do
  263.             if stat = 'Visible' then
  264.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Debit, 'Visible', 1"
  265.             else
  266.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Debit, 'Visible', 0"
  267.         end
  268.         if name = 'Balance' then do
  269.             if stat = 'Visible' then
  270.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Balance, 'Visible', 1"
  271.             else
  272.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Balance, 'Visible', 0"
  273.         end
  274.         if name = 'Memo' then do
  275.             if stat = 'Visible' then do
  276.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Memo, 'Visible', 1"
  277.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'PictMemo', 'PicturePath', '#1010:et_dll'"
  278.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'MenuDisplayMemo', 'Checked', 1"
  279.             end; else do
  280.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Memo, 'Visible', 0"
  281.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'PictMemo', 'PicturePath', '#1009:et_dll'"
  282.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'MenuDisplayMemo', 'Checked', 0"
  283.             end
  284.         end
  285.         if name = 'Category' then do
  286.             if stat = 'Visible' then do
  287.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Cat, 'Visible', 1"
  288.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'PictCat', 'PicturePath', '#1003:et_dll'"
  289.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'MenuDisplayCat', 'Checked', 1"
  290.             end; else do
  291.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Cat, 'Visible', 0"
  292.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'PictCat', 'PicturePath', '#1002:et_dll'"
  293.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'MenuDisplayCat', 'Checked', 0"
  294.             end
  295.         end
  296.         if name = 'MultiCategory' then do
  297.             if stat = 'Visible' then do
  298.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Multi, 'Visible', 1"
  299.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'PictMulti', 'PicturePath', '#1012:et_dll'"
  300.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'MenuDisplayMulti', 'Checked', 1"
  301.             end; else do
  302.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Multi, 'Visible', 0"
  303.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'PictMulti', 'PicturePath', '#1011:et_dll'"
  304.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'MenuDisplayMulti', 'Checked', 0"
  305.             end
  306.         end
  307.         if name = 'Cleared' then do
  308.             if stat = 'Visible' then
  309.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Cancel, 'Visible', 1"
  310.             else
  311.                 call VRMethod 'Application', 'PostQueue', tID, 1, "call VRMethod 'CNRegister', 'SetFieldAttr', field.!Cancel, 'Visible', 0"
  312.         end
  313.     end /* if chge = 1 */
  314. end /* i = 1 to newfields.0 */
  315. call VRMethod 'Application', 'PostQueue', tID, 1, "call VRSet 'CNRegister', 'Painting', 1"
  316. return
  317.  
  318. /*:VRX         Quit
  319. */
  320. Quit:
  321.     call VRMethod 'Application', 'PutVar', 'fields.'
  322.     call VRMethod 'Application', 'PostQueue', tID, 1, 'call end_MenuLedgerFieldOrder_Click'
  323.     window = VRWindow()
  324.     call VRSet window, "Shutdown", 1
  325.     drop window fields. filename tID name stat chge newfields. recHandle field.!Chge field.!Stat field.!Name
  326. return
  327.  
  328. /*:VRX         SWMsg_Close
  329. */
  330. SWMsg_Close:
  331.     window = VRInfo( "Object" )
  332.     call VRDestroy window
  333.     drop window
  334. return
  335. /*:VRX         Window1_Close
  336. */
  337. Window1_Close:
  338.     call Quit
  339. return
  340.  
  341. /*:VRX         Window1_Create
  342. */
  343. Window1_Create:
  344. if fields.0 = 0 then do
  345.     fields.0 = 10
  346.     fields.1 = 'Date'
  347.     fields.2 = 'Number'
  348.     fields.3 = 'Particulars'
  349.     fields.4 = 'Credit'
  350.     fields.5 = 'Debit'
  351.     fields.6 = 'Balance'
  352.     fields.7 = 'Memo'
  353.     fields.8 = 'Category'
  354.     fields.9 = 'MultiCategory'
  355.     fields.10 = 'Cleared'
  356. end
  357. call VRSet 'CNField', 'Painting', 0
  358. field.!Name = VRMethod( 'CNField', 'AddField', 'String', 'Title' )
  359. field.!Stat = VRMethod( 'CNField', 'AddField', 'String', 'Status' )
  360. field.!Chge = VRMethod( 'CNField', 'AddField', 'ULong', 'Changed' )
  361. call VRMethod 'CNField', 'SetFieldAttr', field.!Chge, 'Visible', 0
  362. do i = 1 to fields.0
  363.     recHandle = VRMethod( "CNField", "AddRecord", , "", fields.i, "File", ,  )
  364.     if recHandle <> '' then do
  365.         parse var fields.i name stat
  366.         call VRMethod 'CNField', 'SetFieldData', recHandle, field.!Name, name
  367.         if stat = '' then
  368.             call VRMethod 'CNField', 'SetFieldData', recHandle, field.!Stat, 'Visible'
  369.         else
  370.             call VRMethod 'CNField', 'SetFieldData', recHandle, field.!Stat, 'Hidden'
  371.         call VRMethod 'CNField', 'SetFieldData', recHandle, field.!Chge, 0
  372.     end
  373. end
  374. call VRSet 'CNField', 'Painting', 1
  375. call VRMethod 'Application', 'PutVar', 'fields.'
  376. return
  377.  
  378. /*:VRX         Window1_Help
  379. */
  380. Window1_Help: 
  381. address cmd 'view e-teller Fields...'
  382. return
  383.  
  384.